Migration circle diagram

library(circlize)

## ========================================
## circlize version 0.4.9
## CRAN page: https://cran.r-project.org/package=circlize
## Github page: https://github.com/jokergoo/circlize
## Documentation: https://jokergoo.github.io/circlize_book/book/
## 
## If you use it in published research, please cite:
## Gu, Z. circlize implements and enhances circular visualization
##   in R. Bioinformatics 2014.
## 
## This message can be suppressed by:
##   suppressPackageStartupMessages(library(circlize))
## ========================================

library(tidyverse)

## ── Attaching packages ──────────────────────────────────────────────────────── tidyverse 1.3.0 ──

## ✓ ggplot2 3.3.0     ✓ purrr   0.3.4
## ✓ tibble  3.0.1     ✓ dplyr   0.8.5
## ✓ tidyr   1.0.2     ✓ stringr 1.4.0
## ✓ readr   1.3.1     ✓ forcats 0.5.0

## ── Conflicts ─────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

library(gt)
library(skimr)
library(officer)

source("01_prep-data.R")

## 
## Attaching package: 'readxl'

## The following object is masked from 'package:officer':
## 
##     read_xlsx

## 
## Attaching package: 'janitor'

## The following objects are masked from 'package:stats':
## 
##     chisq.test, fisher.test

## New names:
## * `` -> ...1
## * `` -> ...2
## * `` -> ...3
## * `` -> ...4
## * `` -> ...5
## * ...

## Parsed with column specification:
## cols(
##   `Global Code` = col_character(),
##   `Global Name` = col_character(),
##   `Region Code` = col_character(),
##   `Region Name` = col_character(),
##   `Sub-region Code` = col_character(),
##   `Sub-region Name` = col_character(),
##   `Intermediate Region Code` = col_character(),
##   `Intermediate Region Name` = col_character(),
##   `Country or Area` = col_character(),
##   `M49 Code` = col_character(),
##   `ISO-alpha3 Code` = col_character(),
##   `Least Developed Countries (LDC)` = col_character(),
##   `Land Locked Developing Countries (LLDC)` = col_character(),
##   `Small Island Developing States (SIDS)` = col_character(),
##   `Developed / Developing Countries` = col_character()
## )

## Warning: 1 parsing failure.
## row col   expected     actual                                                            file
## 118  -- 15 columns 11 columns '/Users/petr/carchive/migration-diagram/data-input/un_list.tsv'

## Warning: NAs introduced by coercion

Načíst data

source("02_prep-colours.R")

## 
## Attaching package: 'magrittr'

## The following object is masked from 'package:purrr':
## 
##     set_names

## The following object is masked from 'package:tidyr':
## 
##     extract

df <- read_rds("data-processed/orig-dest-new.rds")

Upravit data

dfl <- df %>% 
  filter(value > 0) %>% 
  drop_na() %>% 
  select(from = origin, to = destination, value)

dfl

Zkontrolovat, jestli jsou řádky unikátní

distinct(dfl, from, to)

Počet řádků stejný, jako u konečného datasetu, takže fajn.

Vykreslit graf:

circos.clear()
chordDiagram(df)

## There are more than one numeric columns in the data frame. Take the
## first two numeric columns and draw the link ends with unequal width.

Hmm, to vypadá fakt divně a nevím proč. Zkusíme funkci stavěnou na data frame, ne na matici:

circos.clear()
chordDiagramFromDataFrame(dfl, directional = 1)

dfl_filtered <- dfl %>% 
  ungroup() %>% 
  filter(value > 8e4) %>% 
  mutate(value = value/1e5,
         # to = str_replace(to, "Europe", "čáěšžěšéí"),
         # from = str_replace(from, "Europe", "čáěšžěšéí"),
         from = str_replace(from, "South-eastern Asia", "SouthEastern Asia") %>%
           str_wrap(10),
         to = str_replace(to, "South-eastern Asia", "SouthEastern Asia") %>% 
           str_wrap(10))
dfl_filtered

setdiff(dfl_filtered$from, dfl_filtered$to)

## [1] "Caribbean"        "Central\nAmerica" "Central\nAsia"    "Middle\nAfrica"  
## [5] "South\nAmerica"   "Southern\nAsia"   "Southern\nEurope"

setdiff(dfl_filtered$to, dfl_filtered$from)

## [1] "Northern\nAmerica"

scales::show_col(cols, borders = F)

names(cols)

##  [1] "yellow"       "orange"       "wine"         "brown"        "purple"      
##  [6] "blue_light"   "blue_dark"    "green"        "yellow_l"     "orange_l"    
## [11] "wine_l"       "brown_l"      "purple_l"     "blue_light_l" "blue_dark_l" 
## [16] "green_l"

nazevnik <- tribble(~ordered_en, ~ordered_cz, ~color_old, ~color,
                    "Eastern Africa","Východní Afrika","darkgreen",cols[["yellow"]],
                    "Middle Africa","Střední Afrika","chartreuse4",cols[["yellow_l"]],
                    "Northern Africa","Severní Afrika","chartreuse3",cols[["orange"]],
                    "Southern Africa","Jižní Afrika","darkolivegreen",cols[["orange_l"]],
                    "Western Africa","Západní Afrika","darkolivegreen3","#e6bd33",
                    "Central Asia","Střední Asie","blue4",cols[["blue_dark"]],
                    "Eastern Asia","Východní Asie","blue1",cols[["blue_dark_l"]],
                    "Southern Asia","Jižní Asie","cornflowerblue",cols[["blue_light_l"]],
                    "SouthEastern Asia","Jihovýchodní Asie","blue1",cols[["blue_light"]],
                    "Western Asia","Západní Asie","deepskyblue","#023FA5",
                    "Eastern Europe","Východní Evropa","brown3",cols[["brown_l"]],
                    "Northern Europe","Severní Evropa","brown1",cols[["brown"]],
                    "Southern Europe","Jižní Evropa","coral",cols[["purple"]],
                    "Western Europe","Západní Evropa","darkred",cols[["purple_l"]],
                    "Caribbean","Karibik","blueviolet",cols[["wine"]],
                    "Central America","Střední Amerika","darkmagenta",cols[["green_l"]],
                    "South America","Jižní Amerika","darkorchid2","#006600",
                    "Northern America","Severní Amerika","darksalmon",cols[["green"]],
                    "Oceania","Oceánie","deeppink3", cols[["wine_l"]]) %>% 
  mutate(label_wrapped_en = str_wrap(ordered_en, 10),
         label_wrapped_cz = str_wrap(ordered_cz, 10))

setdiff(nazevnik$label_wrapped_en, dfl_filtered$from)

## [1] "Southern\nAfrica"  "Northern\nAmerica" "Oceania"

setdiff(dfl_filtered$from, nazevnik$label_wrapped_en)

## character(0)

setdiff(dfl_filtered$to, nazevnik$label_wrapped_en)

## character(0)

length(unique(nazevnik$label_wrapped_cz)) == length(nazevnik$label_wrapped_cz)

## [1] TRUE

# from https://stackoverflow.com/questions/31943102/rotate-labels-in-a-chorddiagram-r-circlize
make_circle_plot <- function(cz = FALSE) {
  
  barvy_grid <- nazevnik$color
  
  names(barvy_grid) <- if(cz) nazevnik$label_wrapped_cz else
    nazevnik$label_wrapped_en
  
  barvy_links <- dfl_filtered %>% 
    left_join(nazevnik %>% rename(from = label_wrapped_en)) %>% 
    pull(color)
  
  if(cz) {
    plot_data <- dfl_filtered %>% 
      left_join(nazevnik %>% select(from = label_wrapped_en, 
                                    label_wrapped_cz)) %>% 
      select(-from) %>%
      rename(from = label_wrapped_cz) %>% 
      left_join(nazevnik %>% select(to = label_wrapped_en,
                                    label_wrapped_cz)) %>% 
      select(-to) %>%
      rename(to = label_wrapped_cz) %>% 
      select(to, from, value)
  } else {
    plot_data <- dfl_filtered %>% 
      select(to, from, value)
  }
  
  # print(plot_data)
  
  order_list <- if(cz) {nazevnik$label_wrapped_cz
  } else {
    nazevnik$label_wrapped_en
  }
  
  # plot_data$to %in% order_list
  # plot_data$from %in% order_list
  
  par(lheight = .8)
  chordDiagramFromDataFrame(plot_data,
                            directional = -1,
                            diffHeight = uh(-3, "mm"),
                            link.arr.type = "triangle",
                            link.arr.width = .30,
                            link.arr.length = .30,
                            link.arr.lwd = 2,
                            # link.arr.col = barvy_links,
                            link.arr.col = c(rep(NA, 10),
                                             "#853946",
                                             rep(NA, 9),
                                             "#023FA5",
                                             rep(NA, 3),
                                             "#023FA5",
                                             rep(NA, nrow(plot_data)-4-21)),
                            direction.type = "arrows+diffHeight",
                            grid.col = barvy_grid,
                            col = barvy_links,
                            transparency = .2,
                            link.lwd = 2,
                            link.border = "white",
                            order = order_list,
                            annotationTrack = "grid",
                            preAllocateTracks = 1)
  circos.trackPlotRegion(track.index = 1, panel.fun = function(x, y) {
    xlim = get.cell.meta.data("xlim")
    ylim = get.cell.meta.data("ylim")
    sector.name = get.cell.meta.data("sector.index")
    circos.text(mean(xlim), ylim[1] + .4, sector.name,
                facing = "clockwise", niceFacing = TRUE, adj = c(0, 0.5))
    circos.axis(h = "top", labels.cex = 0.5, major.at = seq(0, 100, by = 5),
                sector.index = sector.name, track.index = 2, minor.ticks = 4)
  }, bg.border = NA)
  
  # return(plot_data)
}
make_circle_plot(cz = FALSE)

## Joining, by = "from"

cairo_pdf(file = "chart-output/circle_en.pdf", width = 8, height = 8)
make_circle_plot(cz = FALSE)

## Joining, by = "from"

dev.off()

## quartz_off_screen 
##                 2

make_circle_plot(cz = FALSE)

## Joining, by = "from"

cairo_pdf(file = "chart-output/circle_cz.pdf", width = 8, height = 8)
make_circle_plot(cz = TRUE)

## Joining, by = "from"
## Joining, by = "from"

## Joining, by = "to"

dev.off()

## quartz_off_screen 
##                 2

make_circle_plot(cz = TRUE)

## Joining, by = "from"

## Joining, by = "from"

## Joining, by = "to"

Ostatní formáty

ragg::agg_tiff(filename = "chart-output/circle_en.tiff", 
               width = 297, height = 297, units = "mm", res = 300, pointsize = 16)
make_circle_plot(cz = FALSE)

## Joining, by = "from"

dev.off()

## quartz_off_screen 
##                 2

ragg::agg_tiff(filename = "chart-output/circle_cz.tiff", 
               width = 297, height = 297, units = "mm", res = 300, pointsize = 16)
make_circle_plot(cz = TRUE)

## Joining, by = "from"
## Joining, by = "from"

## Joining, by = "to"

dev.off()

## quartz_off_screen 
##                 2

svglite::svglite(file = "chart-output/circle_cz.svg", width = 8, height = 8)
make_circle_plot(cz = TRUE)

## Joining, by = "from"
## Joining, by = "from"

## Joining, by = "to"

dev.off()

## quartz_off_screen 
##                 2

svglite::svglite(file = "chart-output/circle_en.svg", width = 8, height = 8)
make_circle_plot(cz = FALSE)

## Joining, by = "from"

dev.off()

## quartz_off_screen 
##                 2

devEMF::emf("chart-output/circle_cz.emf")
make_circle_plot(cz = TRUE)

## Joining, by = "from"
## Joining, by = "from"

## Joining, by = "to"

dev.off()

## quartz_off_screen 
##                 2

devEMF::emf("chart-output/circle_en.emf")
make_circle_plot(cz = FALSE)

## Joining, by = "from"

dev.off()

## quartz_off_screen 
##                 2

read_pptx() %>% 
  add_slide() %>% 
  ph_with(location = ph_location_fullsize(),
                   value = plot_instr(code = {make_circle_plot(cz = TRUE)})) %>%
  add_slide() %>% 
  ph_with(location = ph_location_fullsize(),
                   value = external_img("chart-output/circle_en.svg")) %>% 
  add_slide() %>% 
  ph_with(location = ph_location_fullsize(),
                   value = external_img("chart-output/circle_en.emf")) %>% 
  add_slide() %>% 
  ph_with(location = ph_location_fullsize(),
                   value = plot_instr(code = {make_circle_plot(cz = FALSE)})) %>%
  add_slide() %>% 
  ph_with(location = ph_location_fullsize(),
                   value = external_img("chart-output/circle_cz.svg")) %>% 
  add_slide() %>% 
  ph_with(location = ph_location_fullsize(),
                   value = external_img("chart-output/circle_cz.emf")) %>% 
  print(target = "chart-output/charts.pptx")

## Joining, by = "from"
## Joining, by = "from"

## Joining, by = "to"

## Loading required namespace: rsvg

## Joining, by = "from"

Rozdíly mezi verzemi

source("98_use-preprocessed-data.R")

## Using ',' as decimal and '.' as grouping mark. Use read_delim() for more control.

## Parsed with column specification:
## cols(
##   .default = col_double(),
##   DESTINATION = col_character()
## )

## See spec(...) for full column specifications.

compar <- dfl_filtered %>% 
  mutate(flow = paste(to, "to", from)) %>% 
  select(-from, -to) %>% 
  full_join(dflo_filtered %>% 
              mutate(flow = paste(from, "to", to)) %>% 
              select(-from, -to, value_old = value)
  ) %>% 
  replace_na(replace = list(value = 0, value = 0)) %>% 
  select(flow, value_old, value) %>% 
  mutate(diff = value - value_old,
         diff_pct = diff/value) %>% 
  arrange(desc(abs(diff_pct)))

## Joining, by = "flow"

compar

compar %>% 
  gt::gt() %>% 
  fmt_number(2:4, decimals = 1) %>% 
  fmt_percent(5, decimals = 1)

flow	value_old	value	diff	diff_pct
South- Eastern Asia to SouthEastern Asia	1.8	0.0	−1.8	−Inf%
South America to South America	1.2	0.0	−1.2	−Inf%
Western Europe to Southern Europe	3.0	2.4	−0.5	−22.2%
Western Europe to Western Europe	1.8	1.5	−0.3	−20.4%
Western Europe to Western Asia	3.6	3.3	−0.3	−8.8%
Western Europe to Eastern Europe	8.5	8.1	−0.3	−4.2%
Western Asia to Northern Africa	2.5	2.4	−0.0	−1.0%
Western Asia to Southern Asia	13.4	13.2	−0.1	−0.9%
Western Asia to SouthEastern Asia	3.5	3.5	−0.0	−0.5%
Western Asia to Western Asia	8.2	8.2	0.0	0.3%
Western Europe to Central Asia	1.9	1.9	−0.0	−0.2%
Northern America to Caribbean	2.1	2.1	0.0	0.0%
Northern America to Eastern Asia	1.8	1.8	0.0	0.0%
Northern America to Southern Asia	1.6	1.6	0.0	0.0%
Northern America to SouthEastern Asia	1.8	1.8	0.0	0.0%
Northern America to South America	1.1	1.1	0.0	0.0%
Northern America to Central America	5.3	5.3	0.0	0.0%
Eastern Africa to Eastern Africa	4.7	4.7	0.0	0.0%
Eastern Asia to Eastern Asia	1.2	1.2	0.0	0.0%
Eastern Europe to Eastern Europe	1.4	1.4	0.0	0.0%
Eastern Africa to Middle Africa	1.2	1.2	0.0	0.0%
Northern Europe to Southern Asia	1.2	1.2	0.0	0.0%
Western Africa to Western Africa	1.2	1.2	0.0	0.0%
Northern Africa to Eastern Africa	NA	0.8	NA	NA
Northern Europe to Eastern Europe	NA	1.0	NA	NA
Western Asia to Eastern Europe	NA	0.9	NA	NA
Northern Europe to Northern Europe	NA	0.9	NA	NA
SouthEastern Asia to SouthEastern Asia	NA	1.8	NA	NA
Western Europe to Southern Asia	NA	0.8	NA	NA